﻿#VisualFreeBasic_Form#  Version=5.4.5
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW,CS_HREDRAW,CS_DBLCLKS
ClassName=模拟软件崩溃
WinStyle=WS_VISIBLE,WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_BORDER,WS_CAPTION,WS_SYSMENU,WS_MAXIMIZEBOX,WS_MINIMIZEBOX,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_POPUP,WS_SIZEBOX
Style=3 - 常规窗口
Icon=
Caption=
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=530
Height=317
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Button]
Name=Command2
Index=-1
Caption=模拟软件崩溃
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=139
Top=104
Width=164
Height=52
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[TopMenu]
Name=TopMenu1
Menu=新菜单0Form1_TopMenu1_Menu10-10新菜单1Form1_TopMenu1_Menu20-10新菜单2Form1_TopMenu1_Menu30-10新菜单3Form1_TopMenu1_Menu40-10
Tag=

[VEH]
Name=VEH1
Left=198
Top=28
Tag=


[AllCode]

Sub Form1_Shown(hWndForm As hWnd, UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。

   
   Dim vi as OSVERSIONINFO
   vi.dwOsVersionInfoSize = SizeOf(OSVERSIONINFO)
   GetVersionEx @vi
   me.Caption = "系统版本：" & vi.dwMajorVersion & "." & vi.dwMinorVersion

End Sub

Sub Form1_Command2_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   'Asm       '汇编模拟崩溃
   'Int 3
   'End Asm
   Dim a() As Long
   a(0) = 100      '模拟常见崩溃
End Sub



Function Form1_VEH1_VectExcepHandler(ByRef excp As EXCEPTION_POINTERS)As Integer  '向量化异常处理（程序崩溃后处理）
   '整个软件，只需一个VEH即可，在主窗口放置控件，所有窗口、模块、多线程等发生崩溃，都会跑到这里执行。
   Select Case excp.ExceptionRecord->ExceptionCode   '发生异常的原因。这是由硬件异常生成的代码，或在RaiseException函数中为软件生成的异常指定的代码 。
      Case EXCEPTION_ACCESS_VIOLATION         'ErrStr = "线程试图读取或写入对其没有适当访问权限的虚拟地址。"
      Case EXCEPTION_ARRAY_BOUNDS_EXCEEDED    'ErrStr = "线程尝试访问超出范围的数组元素，并且基础硬件支持范围检查。"
      Case EXCEPTION_BREAKPOINT               'ErrStr = "遇到断点。"
      Case EXCEPTION_DATATYPE_MISALIGNMENT    'ErrStr = "线程试图读取或写入在不提供对齐方式的硬件上未对齐的数据。例如，必须在2字节边界上对齐16位值；4字节边界上的32位值，依此类推。"
      Case EXCEPTION_FLT_DENORMAL_OPERAND     'ErrStr = "浮点运算中的操作数之一是非正规的。非标准值是一个太小而无法表示为标准浮点值的值。"
      Case EXCEPTION_FLT_DIVIDE_BY_ZERO       'ErrStr = "线程试图将浮点值除以零的浮点除数。"
      Case EXCEPTION_FLT_INEXACT_RESULT       'ErrStr = "浮点运算的结果不能完全表示为小数。"
      Case EXCEPTION_FLT_INVALID_OPERATION    'ErrStr = "此异常表示此列表中未包含的任何浮点异常。"
      Case EXCEPTION_FLT_OVERFLOW             'ErrStr = "浮点运算的指数大于相应类型所允许的大小。"
      Case EXCEPTION_FLT_STACK_CHECK          'ErrStr = "由于浮点运算，堆栈上溢或下溢。"
      Case EXCEPTION_FLT_UNDERFLOW            'ErrStr = "浮点运算的指数小于相应类型所允许的大小。"
      Case EXCEPTION_ILLEGAL_INSTRUCTION      'ErrStr = "线程试图执行无效指令。"
      Case EXCEPTION_IN_PAGE_ERROR            'ErrStr = "该线程试图访问一个不存在的页面，系统无法加载该页面。例如，如果通过网络运行程序时网络连接丢失，可能会发生此异常。"
      Case EXCEPTION_INT_DIVIDE_BY_ZERO       'ErrStr = "线程尝试将整数值除以零的整数除数。"
      Case EXCEPTION_INT_OVERFLOW             'ErrStr = "整数运算的结果导致对结果的最高有效位进行进位。"
      Case EXCEPTION_INVALID_DISPOSITION      'ErrStr = "异常处理程序将无效处置返回给异常调度程序。使用诸如C之类的高级语言的程序员应该永远不会遇到此异常。"
      Case EXCEPTION_NONCONTINUABLE_EXCEPTION 'ErrStr = "发生不可连续的异常后，线程尝试继续执行。"
      Case EXCEPTION_PRIV_INSTRUCTION         'ErrStr = "线程试图执行一条指令，该指令在当前机器模式下是不允许的。"
      Case EXCEPTION_SINGLE_STEP              'ErrStr = "跟踪陷阱或其他单指令机制表明已执行了一条指令。"
      Case EXCEPTION_STACK_OVERFLOW           'ErrStr = "线程耗尽了其堆栈。"
      Case Else
         Return 0  ' 实际使用中，发现 系统内部使用 未知消息（自定义消息），必须 直接返回，让系统自动处理
         '当然还有其它DLL也可能使用 VEH，发生崩溃时，不是在自己写的EXE范围内，也可以直接返回。
   End Select
   Static ExceptionCode As UInteger '有的系统会1次崩溃发生2次相同事件，必须过滤1个
   if ExceptionCode = excp.ExceptionRecord->ExceptionCode Then Return 1   
   ExceptionCode = excp.ExceptionRecord->ExceptionCode
   
   Dim zz As ULong  
   Dim ee As uInteger = Get_Pro_Mo_Ad(GetCurrentProcessId(), App.EXEName, zz)
   if excp.ExceptionRecord->ExceptionAddress< ee OrElse excp.ExceptionRecord->ExceptionAddress> ee+zz Then Return 0 '跳过非自己模块
   ee = Cast(uInteger, @excp) '显示提示BUG窗口
   BugReport.Show, 1, Cast(Integer, @ee) '传递 ee 指针，可以方便返回值来判断。
   '根据 ee 返回，判断是否继续执行
   if ee = 0 Then ExceptionCode = 0 : Return -1 '继续执行
   if ee = 1 Then ExceptionCode = 0 : Return 0  'windows 默认   
   Return 1  '告诉系统结束软件
   'EXCEPTION_EXECUTE_HANDLER     1 表示我已经处理了异常,可以结束了，软件立即结束
   'EXCEPTION_CONTINUE_SEARCH     0 表示我不处理,其他人来吧,于是windows 默认提示软件崩溃（系统未注册调试器的不提示，直接结束）
   'EXCEPTION_CONTINUE_EXECUTION -1 表示错误已经被修复,请从 excp.ContextRecord->Eip 地址继续执行  64位是 excp.ContextRecord->Rip
   
End Function












































































